00100	C   HOMX, LULOOP, 
00200	C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
00300		SUBROUTINE HOMX
00400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW
00500		1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,L,I,IX
00600		2 /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1) /PTR/PWDS(1)
00700		3 /ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
00750		4 /OLDTOP/OLDY
00800		EQUIVALENCE (R3,RJQ(1)),(R7,RJQ(5)),(R9,RJQ(7))
00900		1,(R4,RJQ(2)),(R8,RJQ(6)),(R5,RJQ(3)),(R10,RJQ(8))
01000		
01100		JJ2=1000
01200	C  THE STAFF # =R2
01300		DO 110 K=1,ITEM
01400		IF(CODN(K,L).NE.6)GO TO 110
01500	C RETURNS POINTER IN L
01600	C%%%%%%%%%%%
01700		IF(R2.GT.7)GO TO 10
01800	C  J2=STAFF #.  >7 = ALL STAVES.
01900		IF(RN(L+2).NE.R2)GO TO 110
02000	10	R7=RN(L+7)
02100		IF(R7)GO TO 110
02200	C SKIP TREMOLO AND UNATTACHED PARTIAL BEAMS.
02300		RS=RN(L+2)
02400	C STAFF OF THIS BEAM
02500		ISD=IFIX(R7/10.)
02600	C STEM DIRECTION. 1=UP  2=DOWN
02700		RM=RSTFAC(IFIX(RS))
02800		RSTJ2=RM
02900	C SIZE FACTOR
03000		RL=RN(L+3)
03100		RR=RN(L+6)
03200	C OVERALL LEFT-RIGHT LIMITS
03300		PL=RL
03400		PR=RR
03500	C LEFT-RIGHT POS. TO BE USED
03600		RLH=RN(L+4)
03700		RRH=RN(L+5)
03800	C LEFT-RIGHT HEIGHTS
03900		RMIN=1.
04000		MIN=-1
04100	C  FLAG FOR MINI-NOTES AND BEAMS
04200		W=ABS(RLH)
04300		IF(W.LE.80)GO TO 20
04400	CCC     IF(W.GE.180)GO TO 3
04500	C SKIP IF X NOTES, DIAMONDS, NO NOTE HEAD
04600		MIN=0
04700		RMIN=.6
04800		RM=RM*.6
04900	C MINI SIZE FACTOR
05000		RLH=ABS(RLH)-100.
05100	20	WC=RN(L)
05200	C  WORD COUNT
05300		T=-1
05400		IF(RN(L+10).GE.100)GO TO 30
05500	C P10=100 ETC. =COMPOSITE BEAM WITH AT LEAST 1 COMPLETE ONE.
05600		IF(WC.LT.6)GO TO 30
05700		R8=RN(L+8)
05800		IF(R8.EQ.0)GO TO 30
05900		IF(R8)GO TO 110
06000		IF(WC.LT.7)GO TO 30
06100		R9=RN(L+9)
06200		IF(R9.EQ.0)GO TO 30
06300		PL=R8
06400		PR=R9
06500	C  POS. OF INNER PARTIAL BEAM.
06600		IF(WC.LT.8)GO TO 30
06700		IF(RN(L+10).GT.0)T=RN(L+10)+T
06800	30	IR7=AMOD(R7,10.0)+T
06900	C NUMBER OF BEAMS
07000		PL=PL-.1
07100		PR=PR+.1
07200	C FOR ROUND-OFF ERROR
07300		T=RR-RL
07400	C  TOTAL LENGTH OF FULL BEAM
07500		TH=RRH-RLH
07600	C  TOTAL HEIGHT
07700		T=TH/T
07800	C FACTOR
07900	
08000		DO 100 J=1,ITEM
08100		IF(CODN(J,L).NE.1)GO TO 100
08200		IF(RN(L+2).NE.RS)GO TO 100
08300	C SKIP IF NOT ON RIGHT STAFF
08400		R5=RN(L+5)
08500		IF(R5.LT.10)GO TO 100
08600	C SKIP IF NO STEM ON NOTE
08700		R3=RN(L+3)
08800		IXD=0
08900	CW      A=0
09000		IF(IFIX(R5/10.).EQ.ISD)GO TO 40
09100	C A IS FOR HORZ. DISPLACEMENT DUE TO OPPOSITE STEM DIRECTIONS.
09200		IXD=-1
09300		A=RNW*RM
09400	C  A=WIDTH OF NOTE*SIZE FACTOR   + OR -    RNW=WIDTH OF A NOTE(2.44)
09500		IF(ISD.EQ.1)A=-A
09600		R3=A+R3
09700	40	IF(R3.LT.PL)GO TO 100
09800		IF(R3.GT.PR)GO TO 100
09900	C SKIP IF NOT IN BOUNDS OF BEAM SEGMENT.
10000	CW      R3=A+R3
10100		R4=RN(L+4)
10200		R4X=ABS(R4)
10300		R4=AMOD(R4,100.0)
10400		IF(R4X.LE.80)GO TO 50
10500		IF(R4X.GE.180)GO TO 50
10600		IF(MIN)GO TO 100
10700	C NOW MINI-NOTE
10800	CC      R4=ABS(R4)-100.
10900		IF(R4.GT.80.)R4=R4-100.
11000	C MINIS MAY GO FROM 81 TO 179.  NUMS < 100 ARE CONVERTED TO NUM-100.
11100		GO TO 60
11200	50	IF(MIN.EQ.0)GO TO 100
11300	CC      R4=AMOD(R4,100.0)
11400	CATCH DIAMONDS, X NOTES, HEADLESS NOTES.
11500	60	R6=T*(R3-RL)
11600		R8=RLH+R6-R4
11700	C ADJUSTED STEM LENGTH
11800		IF(ISD.EQ.2)R8=-R8
11900		IF(IXD.EQ.0)GO TO 70
12000		R9=(IR7*1.571429-13.714)*RMIN
12100		R8=-R8
12200	70	IF(RN(L).LT.8)GO TO 90
12300	CHECK P10 FOR STAFF CHANGE FLAG
12400		R10=RN(L+10)
12500		IF(R10.LE.0)GO TO 90
12600		N=-1
12700		IF(R10.EQ.2)N=-N
12800	C N =-1 = ON STAFF BELOW, =1 = ABOVE.
12900		M=RS
13000		R3=ABS((STFF(M+N)-STFF(M))/(RSTJ2*7))
13100		IF(IXD)GO TO 80
13200		IF(R10.NE.ISD)R3=-R3
13300	C ABOVE FOR STEMS SAME DIR, STAFF CHNG IN SAME DIR.
13400	80	R8=R8+R3
13500	C ADDS DISTANCE TO OTHER STAFF - CONVERTED TO NOTE NUMBERS.
13600	90	IF(IXD)R8=R8+R9
13700	C IF OPPOSITE STEM DIR., SUBTRACT (2*STEM AND EXTRA BEAM SPACE)*SIZE
13800		IF(R8.LT.-5)GO TO 100
13900	C AFTER ALL THAT, IF BEAM IS TOO SMALL THEN IGNORE IT.
14000		IF(JJ2.GT.J)JJ2=J
14100	C  POINT TO 1ST ITEM TO RE-DISPLAY
14200		RN(L+8)=R8
14300		R7=RN(L+7)
14400	C NEXT DELETES TAILS
14500		IF(R7.EQ.0)GO TO 100
14600		N=AMOD(R7,10.)
14700		RN(L+7)=R7-N
14800	100	CONTINUE
14900	110	CONTINUE
15000		IF(JJ2.EQ.1000)JJ2=-1
15100		END
15200	
15300		SUBROUTINE SHRINK(JIT)
15400		COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
15500		1 /ALF/A,B,C,K,M,N,MM
15600		IF(JIT.EQ.0)JIT=1
15700		MM=I
15800		DO 40 K=ITEM,JIT,-1
15900		L=KWDS(K)
16000		M=RN(L)
16100		IF(M.LE.2)GO TO 40
16200		J=M+2+L
16300		IF(RN(L+1).NE.1)GO TO 10
16400		IF(RN(L+8).EQ.0)RN(L+8)=999
16500	C  NOTES MUST HAVE AT LEAST 8 PARAMS.
16600	10	DO 20 N=J,L,-1
16700	20	IF(RN(N).NE.0)GO TO 30
16800		GO TO 40
16900	30	IF(N.EQ.J)GO TO 40
17000		M=I-N
17100		CALL RLOOP(RN(N+1),RN(J+1),M)
17200		MM=J-N
17300		RN(L)=RN(L)-MM
17400	C RESET THE WDCNT.
17500		I=I-MM
17600	40	CONTINUE
17700		L=KWDS(JIT)
17800	50	JIT=JIT+1
17900		L=RN(L)+3+L
18000	C  POINTER TO NEXT ITEM
18100		KWDS(JIT)=L
18200		IF(JIT.LE.ITEM)GO TO 50
18300		END
18400	
18500		SUBROUTINE LULOOP
18600		COMMON /ALF/ INP(1)
18700		ICOM=0
18800		DO 10 K=1,72
18900		IF(ICOM.LT.0)INP(K)=' '
19000		J=INP(K)
19100		IF(J.NE.'<')GO TO 1
19200		INP(K)=' '
19300		ICOM=-1
19400		GO TO 10
19500	C USE '<' FOR COMMENTS.  IGNORES REST OF LINE.
19600	1	IF(J.EQ.' ')GO TO 10
19700		INP(K)=J.AND..NOT.((J/2).AND."201004020100)
19800	10	CONTINUE
19900		END
20000	
25000	 	SUBROUTINE RREAD(I,V)
25100	C TAKES ASCII INPUT (INP) STRING, SEPARATES LETTERS FROM NUMBERS.
25200	C MAKES ALL NUMBS FLTING PT.  FILLS UP END OF ARRAY WITH ZEROS.
25300	C SENDS BACK IN V ARRAY. 
25400	C E.G. 'GET FOO 4.55'  SENDS BACK V1=0, V2=0, V3=4.55, V4=0, ETC.
25500	 	DIMENSION I(1),V(1)
25600	 	EQUIVALENCE (N,RN)
25700	 	DO 62 J=1,50
25800	C ZERO V AND IV ARRAYS.****** 50 IS DIMENSION GIVEN IN MARKZ,BEAMS,SLURZ *********
25900	 62	V(J)=0
26000	 	DO 6  LEND=71,1,-1
26100	 6	IF(I(LEND).NE.' ')GO TO 7
26200	C LEND=END OF CHARS.	STARTS WITH NEXT-TO-LAST (LAST IS *)
26300	 	RETURN 
26400	9	IF(LETR.EQ.0)M=M+1
26500		LETR=-1
26600		GO TO 16
26700	 7	M=1
26800	 	J=1
26900		LETR=0
27000	 8	N=I(J)
27100	 	CALL LO2UP(N)
27200	 	IF(N.NE.' '.AND.N.NE.'/')GO TO 11
27300	C IGNORES BLANKS AND SLASHES
27400		LETR=0
27500		GO TO 16
27600	11	IF(N.EQ.'-')GO TO 16
27700	CX	IF(N.NE.'F')GO TO 1
27800	C THIS IS FOR FINGERING NUMS.  /3 F4/5 F1/ ETC.
27900	CX	NN=I(J+1)
28000	CX	IF(NN.GE.'0'.AND.NN.LE.'9')GO TO 9
28100	C CONSIDER 'F4' ETC. AS A UNIT.
28200	C IGNORE '-' (BUT LOOK IN NUMZ TO SEE IF JUST BEFORE A NUM.)
28300	C 	IF(N.NE.'-'.AND.
28400	C 	1 N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
28500	CRR***	IF( N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
28600	
28700	1 	IF( N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 9
28800	C NOW IT'S A NUMBER
28900	 20	CALL NUMZ(KK,I(J),V(M))
29000	 	J=J+KK-1
29100	CXX	LETR=0
29200	C  ABOVE IS NEW ON OCT. 1, 1980 *******
29300	 10	M=M+1
29400	 16	J=J+1
29500	 	IF(J.LE.LEND)GO TO 8 
29600	 	END
29700	 
29800	 	SUBROUTINE NUMZ(KK,I,X)
29900	 	DIMENSION I(1)
30000	 	DATA IZERO/'0'/,ININE/'9'/
30100	 	J=-1
30200	 	M=0
30300	 	XMINUS=1.
30400		IF(I(0).EQ.'-')XMINUS=-XMINUS
30500	C  I(0) MIGHT NOT WORK WITH SOME FORTRANS!!
30600	 	DO 21 KK=1,15
30700	C IS 15 ENOUGH?  YES, WILL DO ONLY 8 DIGITS PLUS DECI.PT.
30800	 	IX=I(KK)
30900	 	IF(IX.GE.IZERO.AND.IX.LE.ININE)GO TO 22
31000	C 	IF(IX.EQ.'-')GO TO 24
31100	 	IF(IX.NE.'.')GO TO 20
31200	 	J=KK
31300	 	GO TO 21
31400	C  24	XMINUS=-XMINUS
31500	C 	GO TO 21
31600	 22	N=(IX-IZERO)/536870912
31700	 	M=N+M*10
31800	 21	CONTINUE
31900	 20	IF(J.LT.0)GO TO 23
32000	 	X=KK-J-1
32100	 	X=XMINUS*M/(10.**X)
32200	 	RETURN
32300	 23	X=XMINUS*M
32400	C FOR NO DECI.
32500	 	END
32600	 
32700	C**IRCAM** 	SUBROUTINE NUMLTR(L,J)
32800	C**IRCAM**C THIS, AND ABOVE ROUTINES, TAKES CARE OF STANFORD 'REREAD' FEATURE
32900	C**IRCAM**C 'RREAD' IS CALLED JUST AFTER ORIGINAL READ STATEMENT
33000	C**IRCAM** 	COMMON R2,JA,CEN,J2,RJQ(20)  /SCM/V(22)
33100	C**IRCAM** 	J=V(1)
33200	C**IRCAM** 	N=L+1
33300	C**IRCAM** 	R2=V(N)
33400	C**IRCAM** 	DO 1 K=1,20
33500	C**IRCAM** 1	RJQ(K)=V(K+N)
33600	C**IRCAM** 	END